home *** CD-ROM | disk | FTP | other *** search
/ The Best of MacTutor - S…e Code for Volumes 1 to 5 / The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin / Source Code / #48 (Sep 89) / Zoundz Source / MyPrintStuff.Pas < prev    next >
Pascal/Delphi Source File  |  1989-05-08  |  6KB  |  266 lines
  1. unit MyPrintStuff;
  2. interface
  3.     uses
  4.         PrintTraps, Sound, MyGlobals, MySound, Message;
  5.  
  6.     procedure doSetUp;
  7.     procedure doPrint;
  8.  
  9. implementation
  10.     var
  11.         theItem: integer;
  12.  
  13.     procedure doSetUp;
  14.         var
  15.             confirmed: boolean;
  16.     begin
  17.         PrOpen;
  18.         InitCursor;
  19.         confirmed := PrValidate(ThePrintRec);
  20.         confirmed := PrStlDialog(ThePrintRec);
  21.         if PrError <> noErr then
  22.             A_Message('Problem with style dialog', '', '', '', theItem)
  23.         else
  24.             PageRect := ThePrintRec^^.prInfo.rpage;
  25.         PrClose;
  26.     end;
  27.  
  28.     procedure PrintIt;
  29.         var
  30.             leftEdge, lineTop, lineBottom, lineSize: integer;
  31.             title: str255;
  32.             i: integer;
  33.  
  34.         procedure NumToHexString (n: longint; var s: str255);
  35.             var
  36.                 d, i: integer;
  37.         begin
  38.             s := '';
  39.             i := 32;
  40.             while i > 0 do
  41.                 begin
  42.                     d := BitAnd(n, 15);
  43.                     n := BitShift(n, -4);
  44.                     i := i - 4;
  45.                     if d < 10 then
  46.                         s := concat(chr(ord('0') + d), s)
  47.                     else
  48.                         s := concat(chr(ord('A') + d - 10), s);
  49.                 end;
  50.         end;
  51.  
  52.         procedure LineFeed;
  53.         begin
  54.             lineTop := lineTop + lineSize;
  55.             lineBottom := lineBottom + lineSize;
  56.             MoveTo(leftEdge, lineBottom);
  57.         end;
  58.  
  59.         procedure PrintHeader;
  60.             var
  61.                 s1: str255;
  62.         begin
  63.             s1 := 'Snd  name is "';
  64.             s1 := concat(s1, title, '"');
  65.             MoveTo(leftEdge, lineBottom);
  66.             TextFace([bold]);
  67.             DrawString(s1);
  68.             TextFace([]);
  69.             LineFeed;
  70.             LineFeed;
  71.         end;
  72.  
  73.         procedure PrintFirstPart;
  74.             var
  75.                 s1, s2: str255;
  76.                 num: longint;
  77.         begin
  78.             num := MySoundHandle^^.format;
  79.             s1 := 'Snd  Format = ';
  80.             NumToString(num, s2);
  81.             s1 := concat(s1, s2);
  82.             DrawString(s1);
  83.             LineFeed;
  84.  
  85.             num := MySoundHandle^^.SynthCount;
  86.             s1 := 'Synthizers = ';
  87.             NumToString(num, s2);
  88.             s1 := concat(s1, s2);
  89.             DrawString(s1);
  90.             LineFeed;
  91.  
  92.             num := MySoundHandle^^.SynthType;
  93.             s1 := 'Snd  Format = ';
  94.             NumToString(num, s2);
  95.             s1 := concat(s1, s2, ' (noteSynth)');
  96.             DrawString(s1);
  97.             LineFeed;
  98.  
  99.             num := MySoundHandle^^.SynthInit;
  100.             s1 := 'Snd  Initialization = ';
  101.             NumToHexString(num, s2);
  102.             s1 := concat(s1, '$', s2);
  103.             DrawString(s1);
  104.             LineFeed;
  105.  
  106.             num := MySoundHandle^^.CommandCount;
  107.             s1 := 'Number of Sound Commands = ';
  108.             NumToString(num, s2);
  109.             s1 := concat(s1, s2);
  110.             DrawString(s1);
  111.             LineFeed;
  112.  
  113.             DrawString('  #  cmd     param1     param2  Description');
  114.             MoveTo(leftEdge, lineBottom + 2);
  115.             LineTo(PageRect.right, lineBottom + 2);
  116.             MoveTo(leftEdge, lineBottom);
  117.             LineFeed;
  118.         end;
  119.  
  120.         procedure PrintNote (i: integer);{  #     cmd     param1     param2     Description }
  121.             var
  122.                 s1, s2, s3: str255;
  123.                 num: longint;
  124.                 c, p1: integer;
  125.                 p2: longint;
  126.         begin
  127.             c := MySoundHandle^^.MySounds[i].cmd;
  128.             p1 := MySoundHandle^^.MySounds[i].param1;
  129.             p2 := MySoundHandle^^.MySounds[i].param2;
  130.  
  131.             num := i; {put index number}
  132.             NumToString(num, s1);
  133.             if i < 10 then
  134.                 s1 := concat(' ', s1);
  135.             if i < 100 then
  136.                 s1 := concat(' ', s1);
  137.             s1 := concat(s1, '   ');
  138.  
  139.             NumToString(c, s2);
  140.             if c < 10 then
  141.                 s2 := concat(' ', s2);
  142.             s1 := concat(s1, s2, '  $');
  143.  
  144.             NumToHexString(p1, s2);
  145.             NumToHexString(p2, s3);
  146.             s1 := concat(s1, s2, '  $', s3, '  ');
  147.  
  148.             case c of
  149.                 quietCmd: 
  150.                     begin
  151.                         s1 := concat(s1, 'quietCmd - The End');
  152.                     end;
  153.                 timbreCmd: 
  154.                     begin
  155.                         s1 := concat(s1, 'timbreCmd - Value ');
  156.                         NumToString(p1, s2);
  157.                         s1 := concat(s1, s2);
  158.                     end;
  159.                 restCmd: 
  160.                     begin
  161.                         s1 := concat(s1, 'restCmd - Rest ');
  162.                         NumToString(p1, s2);
  163.                         s1 := concat(s1, s2, ' milliseconds');
  164.                     end;
  165.                 noteCmd: 
  166.                     begin
  167.                         s1 := concat(s1, 'noteCmd - Note ');
  168.                         num := BitAnd(p2, $FF);
  169.                         NumToString(num, s2);
  170.                         s1 := concat(s1, s2, ', Amp. ');
  171.                         num := BitAnd(BitShift(p2, -24), $FF);
  172.                         NumToString(num, s2);
  173.                         s1 := concat(s1, s2, ', Duration ');
  174.                         NumToString(p1, s2);
  175.                         s1 := concat(s1, s2, ' milliseconds');
  176.                     end;
  177.                 otherwise
  178.                     begin
  179.                         s1 := concat(s1, 'Unknown sound command');
  180.                     end;
  181.             end;
  182.             DrawString(s1);
  183.         end;
  184.  
  185.     begin
  186. {set up position}
  187.         PenNormal;
  188.         TextFont(monaco);
  189.         TextFace([]);
  190.         TextSize(9);
  191.         lineTop := PageRect.top;
  192.         lineSize := 12;
  193.         lineBottom := lineTop + lineSize;
  194.         leftEdge := 30;
  195.         GetWTitle(MyWindow, title);
  196.         PrOpenPage(ThePrintPort, nil); {open page}
  197.         PrintHeader; {print header}
  198.         PrintFirstPart; {print first part}
  199.         for i := 1 to MySoundHandle^^.CommandCount do {for each note}
  200.             begin
  201.                 if lineBottom > PageRect.bottom then
  202.                     begin    {if position is too great}
  203.                         PrClosePage(ThePrintPort);{close page}
  204.                         PrOpenPage(ThePrintPort, nil); {open page}
  205.                         lineTop := PageRect.top;
  206.                         lineBottom := lineTop + lineSize;
  207.                         PrintHeader; {print header}
  208.                         DrawString('  #  cmd     param1     param2  Description');
  209.                         MoveTo(leftEdge, lineBottom + 2);
  210.                         LineTo(PageRect.right, lineBottom + 2);
  211.                         MoveTo(leftEdge, lineBottom);
  212.                         LineFeed;
  213.                     end;
  214.                 PrintNote(i);{print note}
  215.                 LineFeed;
  216.             end;
  217.         PrClosePage(ThePrintPort);{close page}
  218.     end;
  219.  
  220.     procedure doPrint;
  221.         var
  222.             DoIt: boolean;
  223.             myPrPort: TPPrPort;
  224.             savePort: GrafPtr;
  225.             copies, count: integer;
  226.     begin
  227.         GetPort(savePort);
  228.         SetCursor(arrow);
  229.         PrOpen;
  230.         if PrError = noErr then
  231.             begin
  232.                 DoIt := PrValidate(ThePrintRec);
  233.                 DoIt := PrJobDialog(ThePrintRec);
  234.                 if PrError <> noErr then
  235.                     A_Message('Problem with job dialog', '', '', '', theItem);
  236.                 if DoIt then
  237.                     begin {print document}
  238.                         SetCursor(theWatch^^);
  239.                         ThePrintPort := PrOpenDoc(ThePrintRec, nil, nil);
  240.                         if PrError = noErr then
  241.                             begin {ok port}
  242.                                 CreateSndResource(MyDoc^.StartValue, MyDoc^.EndValue);
  243.                                 copies := ThePrintRec^^.prJob.iCopies;
  244.                                 PageRect := ThePrintRec^^.prInfo.rpage;
  245.                                 for count := 1 to copies do
  246.                                     begin {copies loop}
  247.                                         PrintIt; {print the document}
  248.                                     end; {copies loop}
  249.                                 DisposHandle(MyHandle);
  250.                                 DisposHandle(Handle(MySoundHandle));
  251.                                 MyHandle := nil;
  252.                                 MySoundHandle := nil;
  253.                             end
  254.                         else {bad port}
  255.                             A_Message('Open Document Error', '', '', '', theItem);
  256.                         PrCloseDoc(ThePrintPort);
  257.                         if (ThePrintRec^^.prJob.bJDocLoop = bSpoolLoop) and (PrError = noErr) then
  258.                             PrPicFile(ThePrintRec, nil, nil, nil, PrintStatus);
  259.                     end; {printing document}
  260.             end;
  261.         PrClose;
  262.         SetPort(savePort);
  263.         SetCursor(arrow)
  264.     end;
  265.  
  266. end.